home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / pcontur2.zip / PCONTUR2.BAS < prev    next >
BASIC Source File  |  1993-07-23  |  4KB  |  185 lines
  1. '*****************REM READ DATA FILE
  2. PRINT "SAMPLE DATA IS ' TEST.CSV ' "
  3. INPUT "ENTER FILE NAME "; F$
  4. 'F$ = "TEST.CSV"
  5. INF = FREEFILE
  6. OPEN F$ FOR INPUT AS #INF
  7. TSR% = 1
  8. INPUT #1, NR
  9. INPUT #1, NC
  10. INPUT #1, MAX
  11. INPUT #1, MIN
  12. INPUT #1, DX
  13. INPUT #1, DY
  14. DIM H((NR - 1), (NC - 1))
  15. FOR I = (NR - 1) TO 0 STEP -1
  16. FOR J = 0 TO (NC - 1)
  17. INPUT #1, H1
  18. H(I, J) = H1
  19. NEXT J
  20. NEXT I
  21. CLOSE #INF
  22.  
  23. SCR% = 1 'COLOR
  24. SCD% = 2 'COLOR
  25. 60 ON (SCR% + 1) GOTO 62, 64, 66
  26. 62 SCREEN 0: WIDTH 40: GOTO 80
  27. 64 SCREEN 1: GOTO 68
  28. 66 SCREEN 1: GOTO 80
  29. 68 IF SCD% = 1 THEN 80
  30. 70 COLOR 8, 0
  31. 80 KEY OFF
  32. 90 SR% = 1: RGB% = 0
  33.  
  34. 2000 CLS
  35. 2002 SCREEN SCR%: IF SCR% = 0 THEN 2010
  36. 2004 IF SCR% = 1 THEN 2008
  37. 2006 SCREEN 1: GOTO 2010
  38. 2008 COLOR 8, 0
  39. 2010
  40. '2040 PRINT "ROWS = "; NR
  41. 'PRINT "COLUMNS = "; NC
  42. 'PRINT "MIN = "; MIN; " MAX = "; MAX
  43. 'PRINT "SR% = "; SR%
  44. 'INPUT DUM$
  45.  
  46.  
  47. '************************** CONTOUR
  48. 3000 CLS : SCREEN SR%
  49. SCREEN 12
  50.  
  51. GX = 5 * SR%: GY = 5: MG = 0: MH = 0: MV = 0: SX = 240 * SR%: SY = 180: PP = 0
  52. MH = SX / ((NC - 1) * SR%): MV = SY / (NR - 1)
  53.  
  54. IF MH <= MV THEN MG = MH ELSE MG = MV
  55.  
  56. WINDOW (0, 0)-(320 * SR%, 200)
  57.  
  58. IF SR% = 1 THEN RGB = 2 ELSE RGB = 3
  59. PX = GX + (MG * (NC - 1) * SR%): PY = GY + MG * (NR - 1)
  60.  
  61. 3070 LINE (GX, GY)-(PX, PY), RGB, B
  62.  
  63. IF SR% = 1 THEN 3100
  64. 3090 LINE (GX - 1, GY)-(PX - 1, PY), RGB, B
  65.  
  66. 3100 FOR I = 10 TO (NC - 10) STEP 10
  67. FOR J = 10 TO (NR - 10) STEP 10
  68. GPX0 = GX + (MG * I * SR%)
  69. GPX1 = GPX0 - 5 * SR%: GPX2 = GPX0 + 5 * SR%
  70. GPY0 = GY + (MG * J)
  71. GPY1 = GPY0 - 5: GPY2 = GPY0 + 5
  72.  
  73. LINE (GPX1, GPY0)-(GPX2, GPY0), RGB
  74. LINE (GPX0, GPY1)-(GPX0, GPY2), RGB
  75. NEXT J
  76. NEXT I
  77.  
  78. 3195 IF PP = 1 THEN 3880
  79. 3200 REM START OF "MORE CONTOURS "
  80.  
  81. 'LOCATE 1, 2: PRINT "MIN "; MIN; " MAX "; MAX
  82.  
  83. 'LOCATE 3, 32 * TSR%: PRINT "CONTOURS"
  84.  
  85. 'LOCATE 5, 32 * TSR%: INPUT "LOW "; LC
  86. 'LOCATE 6, 32 * TSR%: INPUT "HIGH "; HC
  87. 'LOCATE 10, 32 * TSR%: INPUT "CI "; CI
  88. LC = MIN
  89. HC = MAX
  90. CI = 2
  91.  
  92. 3280 IF LC < (MIN - CI) THEN LC = LC + CI
  93.  
  94. IF HC > MAX THEN HC = MAX
  95.  
  96. 3300 FOR CC = LC TO HC STEP CI
  97. 'LOCATE 12, 32 * TSR%: PRINT CC
  98. 3320 FOR I = 0 TO (NR - 2)
  99.  
  100. 3330 Y0 = MG * I
  101.  
  102. FOR J = 0 TO (NC - 2)                  'LINE  3340
  103. X0 = MG * J
  104. NP = 0
  105. Z1 = H(I, J)
  106.  
  107. IF CC > Z1 THEN NP = NP + 1
  108. Z2 = H(I, (J + 1))
  109. IF CC > Z2 THEN NP = NP + 1
  110. Z3 = H((I + 1), J)
  111. IF CC > Z3 THEN NP = NP + 1
  112. Z4 = H((I + 1), (J + 1))
  113. IF CC > Z4 THEN NP = NP + 1
  114. IF NP = 0 OR NP = 4 THEN GOTO 3840
  115. A = Z1
  116. B = Z2 - A
  117. C = Z3 - A
  118. D = Z4 - A - B - C
  119. ZT = 0
  120.  
  121. FOR Y1 = 0 TO 1 STEP .25
  122. DR = B + D * Y1
  123. IF DR = 0 GOTO 3680
  124. X1 = (CC - A - C * Y1) / DR
  125. IF X1 < 0 OR X1 > 1 GOTO 3680
  126. X = X0 + MG * X1
  127. Y = Y0 + MG * Y1
  128.  
  129. 3580 IF X > PX OR Y > PY GOTO 3670
  130. IF ZT = 0 THEN 3620
  131. 3600 LINE -((X * SR% + GX), (Y + GY)), 1
  132. GOTO 3670
  133. 3620 PSET ((X * SR% + GX), (Y + GY)), 1
  134. IF TL > 0 THEN 3670
  135. IF CC / 10 <> INT(CC / 10) THEN 3670
  136. CCOL = (X * SR% + GX) / 8: CROW = (Y + GY) / 8
  137. IF CCOL < 2 * SR% THEN CCOL = 2 * SR%
  138. IF CCOL > 27 * SR% THEN CCOL = 27 * SR%
  139. IF CROW <= 2 THEN CROW = 2
  140. IF CROW > 22 THEN CROW = 22
  141. IF CC / 20 <> INT(CC / 20) THEN 3639
  142. 3638 LOCATE (25 - CROW), CCOL: GOTO 3640
  143. 3639 LOCATE (24 - CROW), CCOL
  144.  
  145. 3640
  146. '3640 PRINT CC
  147.  
  148. 3650 TL = TL + 1
  149. 3660 GOTO 3620
  150. 3670  ZT = ZT + 1
  151. 3680 NEXT Y1
  152. ZT = 0
  153. FOR X1 = 0 TO 1 STEP .25
  154. DS = C + D * X1
  155. IF DS = 0 GOTO 3830
  156. Y1 = (CC - A - B * X1) / DS
  157. IF Y1 < 0 OR Y1 > 1 GOTO 3830
  158. 3750 X = X0 + MG * X1
  159. Y = Y0 + MG * Y1
  160.  
  161. 3770 IF X > PX OR Y > PY GOTO 3820
  162. 3780 IF ZT = 0 THEN 3810
  163. 3790 LINE -((X * SR% + GX), (Y + GY)), 1
  164. 3800 GOTO 3820
  165. 3810 PSET ((X * SR% + GX), (Y + GY)), 1
  166. 3820 ZT = ZT + 1
  167. 3830 NEXT X1
  168. 3840 NEXT J
  169. 3850 NEXT I
  170. TL = 0
  171. 3870 NEXT CC
  172. 3875 PP = 1: GOTO 3070
  173.  
  174. '3880 GOTO 3200 'NEW
  175.  
  176. '3880 LOCATE 14, 32 * TSR%: PRINT "SCREEN"
  177.  
  178. 3880 LOCATE 5, 50 * TSR%: INPUT "(M)ore or (E)nd "; M$
  179. IF M$ = UCASE$("M") THEN
  180. GOTO 3200
  181. ELSE
  182. END
  183. END IF
  184.  
  185.